COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	stuff for adding strings which are represented as a list of 2 elements,
C00006 ENDMK
C⊗;
;stuff for adding strings which are represented as a list of 2 elements,
; the first is the atom STRING, the second is a list of the characters in the 
; string.
 
 
(defun readstring ()
	(prog (nxtchar temp hdr)
		(setq temp (cons (readch) () ))
		(setq hdr (cons temp temp))
		(return (do ((nxtchar (readch) (readch)))

			    ((and (eq nxtchar '")
				  (not (eq (tyipeek) 42)))
			     (list 'string (car hdr)))
			    
			    (cond ((eq nxtchar '")(readch)))
			    (setq temp (cons nxtchar () ))
			    (rplacd (cdr hdr) temp)
			    (rplacd hdr temp)))))

(defun fexpr string (l) (cons 'string l))
 
 
(setsyntax '" 'macro 'readstring)
 
 
(putprop 'prt (get 'print 'subr) 'subr)
 
 
(defun print (x)
	(cond	((or (atom x) (not (eq (first x) 'string)))
					  (prt x))
		(t (prt (maknam (second x))))))
 

(def is-string (x) (and (not (atom x)) (eq (first x) 'string)
			(null (rest (rest x)))))
 
 
(def s-cat (x y)
	(cond ((not (is-string x))
			(error '(s-cat applied to non-string) x))
              ((not (is-string y))
			(error '(s-cat applied to non-string) y))
	      (t (list 'string (append (second x) (second y))))))
 
 
(def firstch (x)
	(cond	((not (is-string x)) (error '(firstch of non-string)x))
             	((atom (second x)) (error '(firstch of emptystring)x))
		(t (first (second x)))))
 
 
 
(def tail (x)
	(cond	((not (is-string x)) (error '(tail of non-string) x))
		((atom (second x)) (error '(tail of emptystring)x))
		(t (list 'string (rest (second x))))))
 
 
 
(def s-cons (x y)
	(cond ((not (eq (flatc x) 1)) (error '(bad character object, s-cons) x))
	      ((not (is-string y)) (error '(s-cons of non-string) y))
	      (t (list 'string (cons x (second y))))))
 
 
 
(def mk-string (x) (cond	((not (eq (flatc x) 1)) (error '(mk-string of non-character)
								x))
			(t (list 'string (cons x () )))))